PC Answers 1995 June/PC Answers CD-ROM - CD-ROM 8 (Future Publishing) (June 1995).BIN/vbasic/scribble.txt

Text File | 1995-03-06 | 5.3 KB | 226 lines

Option Explicit
'
Const ScribbleMode = 0          ' Scribbling mode
Const LineMode = 1              ' Drawing straight lines
Const StarBurstMode = 2         ' Draw a starburst
'
Dim MouseDown As Integer        ' Declare mouse-down flag
Dim Mode As Integer             ' Declare draw mode variable
Dim StartX As Integer           ' Initial X position
Dim StartY As Integer           ' Initial Y position
Dim LastLineX As Integer        ' Last line end pos
Dim LastLineY As Integer        ' Last line end pos

Sub Black_Click ()
    ForeColor = QBColor(0)
End Sub

Sub Blue_Click ()
    ForeColor = QBColor(1)
End Sub

Sub BWhite_Click ()
    ForeColor = QBColor(15)
End Sub

Sub Cyan_Click ()
    ForeColor = QBColor(3)
End Sub

Sub Form_Load ()

    Mode = ScribbleMode         ' Start off with scribbling
    Scribble.Checked = True     ' check the Scribble item
    MouseDown = False           ' And assume mouse is up
End Sub

Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' If the left mouse button was clicked, then set
    ' up the program variables for a drawing operation

    If (Button And 1) <> 0 Then
        MouseDown = True        ' Flag mouse down

        StartX = X              ' Save initial mouse down X
        StartY = Y              ' Save initial mouse down Y

        LastLineX = -1          ' Init last line end pos
        LastLineY = -1          ' For line drawing mode
    End If

    ' If right mouse button was clicked, then just call 'Refresh'
    ' This has the effect of clearing the program window

    If (Button And 2) <> 0 Then
        Refresh
    End If
End Sub

Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)

    'Set default drawing mode

    DrawMode = 13
    If Mode = ScribbleMode Then
        If MouseDown Then
            CurrentX = StartX       ' Set up start point for this line
            CurrentY = StartY       ' From StartX, StartY coordinates
            Line -(X, Y)            ' Draw the line
            StartX = X              ' Update StartX and...
            StartY = Y              ' ...StartY for next time round
        End If
    End If

    If Mode = LineMode Then
        If MouseDown Then
            DrawMode = 10
            If LastLineX <> -1 Then
                ' We've got an old line - need to remove it
                CurrentX = StartX
                CurrentY = StartY
                Line -(LastLineX, LastLineY)
            End If

            ' Old line is gone, now draw new line
            LastLineX = X
            LastLineY = Y
            CurrentX = StartX
            CurrentY = StartY
            Line -(X, Y)
        End If
    End If

    If Mode = StarBurstMode Then
        If MouseDown Then
            CurrentX = StartX
            CurrentY = StartY
            Line -(X, Y)
        End If
    End If
End Sub

Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
    MouseDown = False       ' Mouse no longer down
    If Mode = LineMode Then
            DrawMode = 13
            CurrentX = StartX
            CurrentY = StartY
            Line -(LastLineX, LastLineY)
    End If
End Sub

Sub Gray_Click ()
    ForeColor = QBColor(8)
End Sub

Sub Green_Click ()
    ForeColor = QBColor(2)
End Sub

Sub LBlue_Click ()
    ForeColor = QBColor(9)
End Sub

Sub LCyan_Click ()
    ForeColor = QBColor(11)
End Sub

Sub LGreen_Click ()
    ForeColor = QBColor(10)
End Sub

Sub Line_Click ()
    Mode = LineMode         ' User has selected line mode
End Sub

Sub LMagenta_Click ()
    ForeColor = QBColor(13)
End Sub

Sub LRed_Click ()
    ForeColor = QBColor(12)
End Sub

Sub LYellow_Click ()
    ForeColor = QBColor(14)
End Sub

Sub Magenta_Click ()
    ForeColor = QBColor(5)
End Sub

Sub P1_Click ()
    DrawWidth = 1
End Sub

Sub P10_Click ()
    DrawWidth = 10
End Sub

Sub P2_Click ()
    DrawWidth = 2
End Sub

Sub P3_Click ()
    DrawWidth = 3
End Sub

Sub P4_Click ()
    DrawWidth = 4
End Sub

Sub P5_Click ()
    DrawWidth = 5
End Sub

Sub P6_Click ()
    DrawWidth = 6
End Sub

Sub P7_Click ()
    DrawWidth = 7
End Sub

Sub P8_Click ()
    DrawWidth = 8
End Sub

Sub P9_Click ()
    DrawWidth = 9
End Sub

Sub Red_Click ()
    ForeColor = QBColor(4)
End Sub

Sub Scribble_Click ()
    Mode = ScribbleMode       ' User has selected scribble mode
    Scribble.Checked = True   ' Scribble menu item is checked
    SLine.Checked = False     ' Line menu item isn't !
    Starburst.Checked = False ' Startburst not checked either
End Sub

Sub SLine_Click ()
    Mode = LineMode           ' We're drawing straight lines
    SLine.Checked = True      ' Line menu item is checked
    Scribble.Checked = False  ' Scribble menu item isn't !
    Starburst.Checked = False ' Starburst not checked either
End Sub

Sub Starburst_Click ()
    Mode = StarBurstMode      ' We're drawing starbursts
    Starburst.Checked = True  ' Starburst menu item checked
    Scribble.Checked = False  ' Scribble menu item isn't !
    SLine.Checked = False     ' Neither is line menu
End Sub

Sub White_Click ()
    ForeColor = QBColor(7)
End Sub

Sub Yellow_Click ()
    ForeColor = QBColor(6)
End Sub